home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / freetype.zip / stacktv.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-07  |  2KB  |  105 lines
  1. (* The Turbo Vision Stack Component. Part of the FreeType Debugger *)
  2.  
  3. unit StackTV;
  4.  
  5. interface
  6.  
  7. uses Objects, Views, Drivers, TTTypes, TTDebug;
  8.  
  9. type
  10.  
  11.   { TStackView }
  12.  
  13.   { A Simple stack display }
  14.  
  15.   PStackView = ^TStackView;
  16.   TStackView = object( TScroller )
  17.                  Pile : PStorage;
  18.                  Top  : ^Int;
  19.                  constructor Init( var Bounds  : TRect;
  20.                                    APile       : PStorage;
  21.                                    var ATop    : Int;
  22.                                    AVScrollBar : PScrollBar );
  23.                  procedure Draw; virtual;
  24.                  procedure Update;
  25.                end;
  26.  
  27.   { TStackWindow }
  28.  
  29.   PStackWindow = ^TStackWindow;
  30.   TStackWindow = object( TWindow )
  31.                    V : PScrollBar;
  32.                    S : PStackView;
  33.                    constructor Init( var Bounds : TRect;
  34.                                          APile  : PStorage;
  35.                                      var ATop   : Int );
  36.                  end;
  37.  
  38. implementation
  39.  
  40. { TStackView }
  41.  
  42. constructor TStackView.Init;
  43. begin
  44.   inherited Init( Bounds, nil, AVScrollBar );
  45.   Pile := APile;
  46.   Top  := @ATop;
  47.   Update;
  48. end;
  49.  
  50. procedure TStackView.Draw;
  51. var
  52.   B       : TDrawBuffer;
  53.   Color   : Byte;
  54.   I, Item : Int;
  55.   S       : String[16];
  56. begin
  57.   Color := GetColor(1);
  58.  
  59.   if Top^ <= Size.Y then Item := Size.Y-1 else Item := Top^-1-Delta.Y;
  60.  
  61.   for I := 0 to Size.Y-1 do
  62.   begin
  63.  
  64.     MoveChar( B, ' ', Color, Size.X );
  65.  
  66.     if Item < Top^ then
  67.       begin
  68.         S :=  Hex16( Item ) + ': ' + Hex32( Pile^[Item] );
  69.         MoveStr( B, S, Color );
  70.       end;
  71.  
  72.     WriteLine( 0, I, Size.X, 1, B );
  73.     dec( Item );
  74.   end;
  75.  
  76. end;
  77.  
  78.  
  79. procedure TStackView.Update;
  80. begin
  81.   if Top^ <= Size.Y then SetLimit( 0, 0 )
  82.                     else SetLimit( 0, Top^-Size.Y );
  83.  
  84.   ScrollTo( 0, 0 );
  85. end;
  86.  
  87. { TStackWindow }
  88.  
  89. constructor TStackWindow.Init;
  90. var
  91.   R : TRect;
  92. begin
  93.   inherited Init( Bounds, 'Pile', wnNoNumber );
  94.   R     := Bounds;
  95.   R.A.X := R.B.X-1;
  96.   inc( R.A.Y );
  97.   dec( R.B.Y );
  98.   New( V, Init(R) );
  99.   R := Bounds;
  100.   R.Grow(-1,-1);
  101.   New( S, Init( R, APile, ATop, V ));
  102. end;
  103.  
  104. end.
  105.